home *** CD-ROM | disk | FTP | other *** search
/ PC World 2002 March / PCWorld_2002-03_cd.bin / Software / TemaCD / xteq / setup.exe / {app} / plugins / XQ MSO2K OTL Security 1.xpl < prev    next >
Text File  |  2001-05-05  |  4KB  |  149 lines
  1. "FILE"="Xteq Systems X-Setup Plugin 6.0"
  2. "TYPE"="8"
  3. "COUNT"="2"
  4. "UIPATH"="Program Options\Microsoft Office\MS Office 2000\Outlook"
  5. "NAME"="Email Files Security"
  6. "VERSION"="1.01"
  7. "LANGUAGE"="VBScript"
  8. "TEXT 1"="Add..."
  9. "TEXT 2"="Remove selection"
  10. "DESCRIPTION 1"="Beginning with Outlook 2000 SR1, Outlooks uses a very strict file type security management. This means, you can not access some files from an email at all (so called "Level 1" files, sometimes also called "blocked files") and some can only be saved to disk but not started ("Level 2" files)."
  11. "DESCRIPTION 2"="For example, EXE files are by default Level 1 files which means you can not start them or save them. Outlook simple blocks them and there is no chance to access them."
  12. "DESCRIPTION 3"="With this setting, you can "Downgrade" some of those Level 1 files (no access to all) to Level 2 files (you can save them to disk)."
  13. "DESCRIPTION 4"="Simply click "Add" and enter the extension you do not have access to (e.g. "EXE") so you can save them to disk from a email."
  14. "AUTHOR"="Xteq Systems"
  15. "CONTACTURL"="http://www.xteq.com/"
  16. "COPYRIGHT"="Copyright ⌐ Xteq Systems - All Rights Reserved"
  17. "COMMENT 1"="See also MS KB Article ID: Q259228"
  18.  
  19.  
  20. sPCheck="HKLM\Software\Microsoft\Office\9.0\"
  21.      sV="HKCU\Software\Microsoft\Office\9.0\Outlook\Security\RemoveWarningFileTypes"
  22.     sV2="HKCU\Software\Microsoft\Office\9.0\Outlook\Security\AddWarningFileTypes"
  23.  
  24. iCount=0
  25.  
  26. Sub Plugin_Initialize 
  27. if RegPathExists(sPCheck) then
  28.    Call InitListbox
  29. else
  30.    Call Disable()
  31. end if
  32. End Sub
  33.  
  34.  
  35.  
  36.  
  37. Sub Plugin_Apply(ElementIndex,ElementSubIndex)
  38.  if ElementIndex=1 then 'ADD
  39.     s=InputWindow("Please enter the extension to unblock, e.g. <EXE>","",1)
  40.     if IsEmpty(s)=false then
  41.        if Len(s)>0 then
  42.           iCount=iCount+1
  43.           Call SetUIElement(iCount,s)
  44.           Call WriteRegistry()
  45.           Call InitListbox()              
  46.        end if
  47.     end if
  48.  
  49.  elseif ElementIndex=2 then 'REMOVE
  50.    if ElementSubIndex=0 then
  51.       Call MsgError("Please select an extension to remove")
  52.    else
  53.       Call SetUIElement(ElementSubIndex,"")
  54.       iCount=iCount-1
  55.  
  56.       Call WriteRegistry()
  57.       Call InitListbox()
  58.    end if
  59.  end if
  60.  
  61.  
  62. ' Call Logoff()
  63. End Sub
  64.  
  65.  
  66. Sub InitListbox
  67.  for i=1 to iCount
  68.      Call SetUIElement(i,"")
  69.  next
  70.  
  71.  iCount=0
  72.  
  73.  s=RegReadValue(sV)
  74.  if IsEmpty(s)=false then
  75.     'Dim ary()
  76.     ary=Split(s,";")
  77.  
  78.     for l=lBound(ary) to ubound(ary)
  79.         s=ary(l)
  80.         s=lcase(s)
  81.         if len(s)>0 then
  82.            sDesc=GetFileDescription("." & s)
  83.  
  84.            iCount=iCount+1
  85.            Call SetUIElement(iCount,s & " (" & sDesc & ")")
  86.         end if
  87.     next
  88.  end if
  89.  
  90. end sub
  91.  
  92.  
  93. Sub WriteRegistry
  94.  s=""
  95.  for i=1 to iCount
  96.      s2=GetUIElement(i)
  97.      iPos=InStr(s2," ")
  98.      if iPos>0 then
  99.         s2=Left(s2,iPos-1)
  100.         s2=LCase(s2)
  101.      end if
  102.  
  103.      if len(s2)>0 then
  104.         s=s & UCASE(s2) & ";"
  105.      end if
  106.  next
  107.  
  108.  Call RegWriteValue(sV,s,1)
  109.  
  110.  
  111.  'Outlook 2000 needs both entires to work properly!
  112.  if RegValueExists(sV2)=false then
  113.     Call RegWriteValue(sV2,"",1)
  114.  end if
  115. End Sub
  116.  
  117.  
  118. Sub Plugin_Terminate 
  119. End Sub
  120.  
  121.  
  122.  
  123.  
  124. 'VERSION 1.1
  125. 'returns the readable description for a file TYPE. Input is the
  126. 'raw file type (e.g. ".TXT"). 
  127. Function GetFileDescription(DotType)
  128.   sxd_BasePath="HKLM\Software\Classes\"
  129.  
  130.   sxd_Path=sxd_BasePath & DotType & "\@"
  131.   sxd_Val=RegReadValue(sxd_Path)
  132.  
  133.   if IsEmpty(sxd_Val)=true then
  134.      'extended description not found! return default
  135.      GetFileDescription="<UNKNOWN>"
  136.   else
  137.      'found, now get the "real" description
  138.      sxd_Path=sxd_BasePath & sxd_Val & "\@"
  139.      sxd_Name=RegReadValue(sxd_Path)
  140.      
  141.      if IsEmpty(sxd_Name)=true then
  142.         'argh! 
  143.         GetFileDescription="<UNKNOWN>"
  144.      else
  145.         GetFileDescription=sxd_Name
  146.      end if
  147.   end if
  148.  
  149. End Function